home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / alphaHooks.tcl < prev    next >
Encoding:
Text File  |  1999-04-09  |  26.2 KB  |  842 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Vince's Additions - an extension package for Alpha
  4.  # 
  5.  #  FILE: "alphaHooks.tcl"
  6.  #                                    created: 18/7/97 {5:10:18 pm} 
  7.  #                                last update: 9/4/1999 {1:30:31 am} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Copyright (c) 1997-1999  Vince Darley, all rights reserved
  15.  #  
  16.  # Description: 
  17.  #  
  18.  #  Here are the current hooks:
  19.  #  
  20.  #  activateHook changeMode closeHook deactivateHook modifyModeFlags 
  21.  #  quitHook resumeHook saveasHook saveHook savePostHook suspendHook
  22.  #  openHook
  23.  #  
  24.  #  There's also a 'mode::init' hook which will be called the first
  25.  #  time a mode is started up.  Note that the mode exists, but its
  26.  #  variables have not yet been made global, and its menus have not
  27.  #  yet been inserted into the menu bar.
  28.  #  
  29.  #  There's also a 'startupHook' which is called when Alpha starts
  30.  #  up, but after all other initialisation has taken place (before
  31.  #  any files are opened though).
  32.  #  
  33.  #  There's also a 'launch' hook for when an app is launched.
  34.  #  
  35.  #  Use of such lists as 'savePostHooks' is obsolete.
  36.  #  These lists are ignored, use hook::register instead.
  37.  #  
  38.  #  History
  39.  # 
  40.  #  modified by  rev reason
  41.  #  -------- --- --- -----------
  42.  #  18/7/97  VMD 1.0 original
  43.  #  22/7/97  VMD 1.1 fixed all bugs ;-) and added the above examples.
  44.  # ###################################################################
  45.  ##
  46.  
  47. namespace eval mode {}
  48. namespace eval win {}
  49.  
  50. lappend mode::procs carriageReturn OptionTitleBar OptionTitleBarSelect \
  51.   electricLeft electricRight electricSemi indentLine indentRegion \
  52.   parseFuncs MarkFile
  53.  
  54. proc saveHook name {
  55.     global backup backupExtension backupFolder mode win::Modes \
  56.       backupAgeRequirementInHours modifiedVars
  57.     hook::callAll saveHook [set win::Modes($name)] $name
  58.     if {![file exists $name]} {
  59.     regsub { <[0-9]+>$} $name {} name
  60.     }
  61.     if {$backup} {
  62.     if {$backupFolder != "" && ![file exists $backupFolder]} {
  63.         if {![dialog::yesno "Create backup folder '$backupFolder'?"]} {
  64.         alertnote "Backup saved in document's folder."
  65.         set backupFolder ""
  66.         lappend modifiedVars backupFolder
  67.         } elseif {[catch {file::ensureDirExists $backupFolder}]} {
  68.         alertnote "Couldn't create backup folder. Backup saved in document's folder."
  69.         set backupFolder ""
  70.         lappend modifiedVars backupFolder
  71.         }
  72.     }
  73.     set dir $backupFolder
  74.  
  75.     if {![string length $dir]} {
  76.         set dir [file dirname $name]
  77.     }
  78.     if {$backupExtension == "" && $backupFolder == ""} {
  79.         set backupExtension ~
  80.         lappend modifiedVars backupExtension
  81.     }
  82.     set backfile [file join $dir [file tail $name]$backupExtension]
  83.     if {$backupExtension == "" && [file dirname $name] == $backupFolder} {
  84.         append backfile ~
  85.     }
  86.     if {[file exists $backfile]} {
  87.         getFileInfo $name a
  88.         if {[expr {([now] - $a(modified) + 0.0)/3600}] < $backupAgeRequirementInHours} {
  89.         return
  90.         }
  91.         catch {file delete $backfile}
  92.     }
  93.     message "Backing up $backfile"
  94.     catch {file copy $name $backfile}
  95.     }
  96.  
  97. }
  98.  
  99. proc saveUnmodified {} {
  100.     set name [win::Current]
  101.     if {[file exists $name] || \
  102.       ([regsub { <\w+>$} $name {} name] && [file exists $name])} {
  103.     getFileInfo $name arr
  104.     set mod $arr(modified)
  105.     save
  106.     setFileInfo $name modified $mod
  107.     return
  108.     }
  109.     # shouldn't really get here!
  110.     error "File doesn't exist"
  111. }
  112.  
  113. ## 
  114.  # -------------------------------------------------------------------------
  115.  # 
  116.  # "changeMode" --
  117.  # 
  118.  #  A very important procedure.  It handles all switching from one mode
  119.  #  to another.  This means it has to adjust menus, floating windows,
  120.  #  global variables, mode prefs, and call a number of hooks.
  121.  #  
  122.  #  It maintains a list of variables which the new mode over-rides from
  123.  #  the global scope, and recreates them.  This allows a mode to have
  124.  #  its own value for a global variable without messing anything up.
  125.  # -------------------------------------------------------------------------
  126.  ##
  127. proc changeMode {newMode} {
  128.     global lastMode dummyProc mode seenMode PREFS global::_varMem \
  129.       mode::features global::features global::_oldTabSize
  130.     
  131.     # This section should restore any internally shadowed globals, 
  132.     # currently only tabSize may be stored by 'new'
  133.     if {[info exists global::_oldTabSize]} {
  134.     global tabSize
  135.     set tabSize [set global::_oldTabSize]
  136.     unset global::_oldTabSize
  137.     }
  138.     
  139.     set lastMode $mode
  140.     set mode $newMode
  141.     if {$lastMode == $mode} {
  142.         if {$newMode != ""} {
  143.         displayMode $newMode
  144.     }
  145.         return
  146.     }
  147.     if {$lastMode == ""} {
  148.     renameMenuItem -m Config "Mode Prefs" "${mode} Mode Prefs"
  149.     catch {menuEnableHook 1}
  150.     } elseif {$mode == ""} {
  151.     renameMenuItem -m Config "${lastMode} Mode Prefs" "Mode Prefs"
  152.     catch {menuEnableHook 0}
  153.     } else {
  154.     renameMenuItem -m Config "${lastMode} Mode Prefs" "${mode} Mode Prefs"
  155.     }
  156.     
  157.     # Get rid of all the old mode's variables, but only if it is necessary
  158.     # (Else we screw up traces on those variables)
  159.     global ${lastMode}modeVars
  160.     if {[info exists ${lastMode}modeVars]} {
  161.         foreach v [array names ${lastMode}modeVars] {
  162.         if {![info exists global::_varMem($v)]} {
  163.         global $v
  164.         catch {unset $v}
  165.         }
  166.         }
  167.     }
  168.     floatShowHide off $lastMode
  169.     if {[info exists global::_varMem]} {
  170.     foreach v [array names global::_varMem] {
  171.         global $v
  172.         set $v [set global::_varMem($v)]
  173.     }
  174.     unset global::_varMem
  175.     }
  176.     if {[info exists mode::features($mode)]} {
  177.     set onoff [package::onOrOff [set mode::features($mode)] $lastMode]
  178.     } else {
  179.     set onoff [package::onOrOff "" $lastMode]
  180.     }
  181.     
  182.     foreach m [lindex $onoff 0] {
  183.     package::deactivate $m
  184.     }
  185.     
  186.     # These lines must load the mode vars into the mode var scope.
  187.     if {[info exists dummyProc($mode)]} { $dummyProc($mode) }
  188.     if {![info exists seenMode($mode)]} {
  189.     hook::callAll mode::init $mode
  190.     }
  191.     # once the vars are in mode-var scope (= the <mode>modeVars array),
  192.     # they can be transfered to the global scope.  A future version of
  193.     # Alpha with Tcl8.0 namespaces may not need to do this.
  194.     global ${mode}modeVars
  195.     if {[info exists ${mode}modeVars]} {
  196.         foreach v [array names ${mode}modeVars] {
  197.             global $v
  198.         if {[info exists $v]} { 
  199.         set global::_varMem($v) [set $v]
  200.         }
  201.             set $v [set ${mode}modeVars($v)]
  202.         }
  203.     }
  204.     foreach m [lindex $onoff 1] {
  205.     package::activate $m
  206.     }
  207.     
  208.     floatShowHide on $mode
  209.  
  210.     if {![info exists seenMode($mode)]} {
  211.     global mode::procs
  212.     #foreach p ${mode::procs} {
  213.     #    if {[info commands ${mode}::${p}] == ""} {
  214.     #    auto_load ${mode}::${p}
  215.     #    }
  216.     #}
  217.     set seenMode($mode) 1
  218.     if {($mode != "") && [file exists [file join $PREFS ${mode}Prefs.tcl]]} {
  219.         if {[catch {uplevel \#0 [list source [file join $PREFS ${mode}Prefs.tcl]]}]} {
  220.                 alertnote "Your preferences file '${mode}Prefs.tcl has an error."
  221.             } 
  222.         }
  223.     }
  224.         
  225.     if {$newMode != ""} {
  226.     displayMode $newMode
  227.     }
  228.  
  229.     hook::callAll changeMode $mode $mode
  230. }
  231.  
  232. ## 
  233.  # -------------------------------------------------------------------------
  234.  # 
  235.  # "requireOpenWindowsHook" --
  236.  # 
  237.  #  En-/disable meaningless menu items which would require the presence
  238.  #  of a certain number of windows to be active
  239.  #  
  240.  #  This proc should only be called from 'openHook' and 'closeHook'.
  241.  #  
  242.  #  You can register with it using 
  243.  #  
  244.  #  'hook::register requireOpenWindowsHook [list menu item] N'
  245.  #  
  246.  #  where 'N' is the number of windows required (1 or 2 usually)
  247.  #  (and deregister etc using hook::deregister).
  248.  #  
  249.  #  We only really need the catch in here for two reasons:
  250.  #  (i) in case bad menus are registered accidentally
  251.  #  (ii) so startup errors can open a window without hitting another error
  252.  #  in the middle of doing that!
  253.  # -------------------------------------------------------------------------
  254.  ##
  255. proc requireOpenWindowsHook {requiredNum} {
  256.     foreach count $requiredNum {
  257.     set enable [expr {[llength [winNames]] >= $requiredNum ? 1 : 0}]
  258.     foreach i [hook::list requireOpenWindowsHook $requiredNum] {
  259.         catch "enableMenuItem $i $enable"
  260.     }
  261.     }
  262. }
  263.  
  264. ## 
  265.  # -------------------------------------------------------------------------
  266.  # 
  267.  # "menuEnableHook" --
  268.  # 
  269.  #  This hook is called to turn menu items on or off.  It is called 
  270.  #  whenever there are no windows, or when we go from 0->1 window.
  271.  #  
  272.  #  It should deal with all standard menus.  It does not deal with
  273.  #  special menu items like 'save', 'revert',.. which require more
  274.  #  information.
  275.  #  
  276.  #  It is called from changeMode.
  277.  #  
  278.  #  Andreas wrote most of this proc.
  279.  #  
  280.  #  Due to a deficiency in MacOS/MercutioMDEF/Alpha (not sure who
  281.  #  the culprit is!), key-bindings attached to menu items are still
  282.  #  triggered even if the menu item is inactive.
  283.  # -------------------------------------------------------------------------
  284.  ##
  285. proc menuEnableHook {{haveWin 1}} {
  286.     global winMenu mode
  287.     # we only get here if there are no windows, or 1 window which we
  288.     # just opened.  Otherwise nothing will be different to last time.
  289.     enableMenuItem File close $haveWin
  290.     enableMenuItem File closeAll $haveWin
  291.     enableMenuItem File closeFloat $haveWin
  292.     enableMenuItem File saveAs… $haveWin
  293.     enableMenuItem File saveACopyAs… $haveWin
  294.     if {[package::active printerChoicesMenu]} {
  295.     enableMenuItem File print $haveWin
  296.     } else {
  297.     enableMenuItem File print… $haveWin
  298.     }
  299.     enableMenuItem File printAll $haveWin
  300.     eval [lindex [list un {}] $haveWin]Bind 'p' <c> print
  301.     
  302.     enableMenuItem Edit undo $haveWin
  303.     enableMenuItem Edit redo $haveWin
  304.     enableMenuItem Edit cut $haveWin
  305.     enableMenuItem Edit copy $haveWin
  306.     enableMenuItem Edit paste $haveWin
  307.     enableMenuItem Edit selectAll $haveWin
  308.     enableMenuItem Edit selectParagraph $haveWin
  309.     enableMenuItem Edit clear $haveWin
  310.     enableMenuItem Edit twiddle $haveWin
  311.     enableMenuItem Edit twiddleWords $haveWin
  312.     enableMenuItem Edit shiftLeft  $haveWin
  313.     enableMenuItem Edit shiftLeftSpace  $haveWin
  314.     enableMenuItem Edit shiftRight  $haveWin
  315.     enableMenuItem Edit shiftRightSpace  $haveWin
  316.     enableMenuItem Edit balance  $haveWin
  317.  
  318.     if {[info tclversion] < 8.0} {
  319.         enableMenuItem Text fillParagraph $haveWin
  320.         enableMenuItem Text wrapParagraph $haveWin
  321.         enableMenuItem Text sentenceParagraph $haveWin
  322.         enableMenuItem Text fillRegion $haveWin
  323.         enableMenuItem Text wrapRegion $haveWin
  324.         enableMenuItem Text sentenceRegion $haveWin
  325.         enableMenuItem Text paragraphToLine $haveWin
  326.         enableMenuItem Text lineToParagraph $haveWin
  327.         enableMenuItem Text reverseSort $haveWin
  328.         enableMenuItem Text sortLines $haveWin
  329.         enableMenuItem Text sortParagraphs $haveWin
  330.         enableMenuItem Text zapInvisibles $haveWin
  331.         enableMenuItem Text tabsToSpaces $haveWin
  332.         enableMenuItem Text spacesToTabs $haveWin
  333.         enableMenuItem Text indentLine $haveWin
  334.         enableMenuItem Text indentSelection $haveWin
  335.         enableMenuItem Text upcaseRegion $haveWin
  336.         enableMenuItem Text downcaseRegion $haveWin
  337.         enableMenuItem Text strings $haveWin
  338.         enableMenuItem Text commentLine $haveWin
  339.         enableMenuItem Text uncommentLine $haveWin
  340.         enableMenuItem Text commentBox $haveWin
  341.         enableMenuItem Text uncommentBox $haveWin
  342.         enableMenuItem Text commentParagraph $haveWin
  343.         enableMenuItem Text uncommentParagraph $haveWin
  344.     enableMenuItem Config "Mode Prefs" $haveWin
  345.     } else {
  346.     enableMenuItem Text "" $haveWin
  347.     if {$mode == ""} {
  348.         enableMenuItem -m Config "Mode Prefs" $haveWin
  349.     } else {
  350.         enableMenuItem -m Config "${mode} Mode Prefs" $haveWin
  351.     }
  352.     }
  353.     
  354.     enableMenuItem Search searchStart $haveWin
  355.     enableMenuItem Search findAgain $haveWin
  356.     enableMenuItem Search findAgainBackward $haveWin
  357.     if { ![string compare [searchString] ""] && !$haveWin } {
  358.     enableMenuItem Search findInNextFile $haveWin
  359.     } else {
  360.     enableMenuItem Search findInNextFile 1
  361.     }
  362.     enableMenuItem Search enterSearchString $haveWin
  363.     enableMenuItem Search enterReplaceString $haveWin
  364.     enableMenuItem Search quickFind $haveWin
  365.     enableMenuItem Search quickFindRegexp $haveWin
  366.     enableMenuItem Search reverseQuickFind $haveWin
  367.     enableMenuItem Search replace $haveWin
  368.     enableMenuItem Search replace&FindAgain $haveWin
  369.     enableMenuItem Search replaceAll $haveWin
  370.     enableMenuItem Search placeBookmark $haveWin
  371.     enableMenuItem Search returnToBookmark $haveWin
  372.     enableMenuItem Search gotoLine $haveWin
  373.     enableMenuItem Search matchingLines $haveWin
  374.     enableMenuItem Search gotoMatch $haveWin
  375.     enableMenuItem Search nextMatch $haveWin
  376.     enableMenuItem Search gotoFunc $haveWin
  377.     enableMenuItem Search gotoFileMark $haveWin
  378.     enableMenuItem Search markHilite $haveWin
  379.     enableMenuItem Search namedMarks $haveWin
  380.     enableMenuItem Search unnamedMarks $haveWin
  381.     
  382.     enableMenuItem Utils AsciiEtc $haveWin
  383.     enableMenuItem Utils cmdDoubleClick $haveWin
  384.     enableMenuItem Utils winUtils $haveWin
  385.     enableMenuItem Utils spellcheckWindow $haveWin
  386.     enableMenuItem Utils spellcheckSelection $haveWin
  387.     enableMenuItem Utils wordCount $haveWin
  388.     
  389.     enableMenuItem Config setFontsTabs… $haveWin
  390.     
  391.     enableMenuItem $winMenu zoom $haveWin
  392.     enableMenuItem $winMenu defaultSize $haveWin
  393.     enableMenuItem $winMenu chooseAWindow $haveWin
  394.     enableMenuItem $winMenu iconify $haveWin
  395.     enableMenuItem $winMenu arrange $haveWin
  396.     enableMenuItem $winMenu splitWindow $haveWin
  397.     enableMenuItem $winMenu toggleScrollbar $haveWin
  398.     
  399.     if {!$haveWin} {
  400.     enableMenuItem File save 0
  401.     enableMenuItem File saveUnmodified 0
  402.     enableMenuItem File revert 0
  403.     enableMenuItem File revertToBackup 0
  404.     enableMenuItem File renameTo… 0
  405.     enableMenuItem File saveAll 0
  406.     }
  407.     
  408.     requireOpenWindowsHook 1
  409. }
  410.  
  411. proc savePostHook name {
  412.     # So modified date is  ok
  413.     if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  414.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  415.       && (![catch {getFileInfo $nm info}]))} {
  416.     global win::Modified
  417.     set win::Modified($name) $info(modified)
  418.     } else {
  419.     if {[info tclversion] < 8.0} {
  420.         # Alpha bug workaround
  421.         set name [subst $name]
  422.         if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  423.           ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  424.           && (![catch {getFileInfo $nm info}]))} {
  425.         global win::Modified
  426.         set win::Modified($name) $info(modified)
  427.         } else {
  428.         alertnote "Weird, file '$name' doesn't seem to exist: please\
  429.           report the circumstances of this problem to the Alpha-D mailing list."
  430.         }
  431.     } else {
  432.         alertnote "Weird, file '$name' doesn't seem to exist: please\
  433.           report the circumstances of this problem to the Alpha-D mailing list."
  434.     }
  435.     }
  436.     hook::callAll savePostHook "" $name
  437. }
  438.  
  439. proc closeHook name {
  440.     global markStack win::Modes win::Active win::Current win::Dirty \
  441.       win::NumDirty win::Modified
  442.     hook::callAll closeHook [set win::Modes($name)] $name
  443.  
  444.     if {[info exists win::Dirty($name)]} {
  445.     incr win::NumDirty -1
  446.     unset win::Dirty($name)
  447.     enableMenuItem File saveAll [expr {${win::NumDirty} ? 1 : 0}]
  448.     }
  449.         
  450.     unset win::Modes($name)
  451.     if {[info exists win::Modified($name)]} {
  452.     unset win::Modified($name)
  453.     }
  454.     
  455.     if {[llength $markStack]} {
  456.         set markStack [lremove -glob $markStack $name*]
  457.     }
  458.     win::removeFromMenu $name
  459.  
  460.     if {[set ind [lsearch -exact ${win::Active} $name]] >= 0} {
  461.         set win::Active [lreplace ${win::Active} $ind $ind]
  462.     }
  463.     if {![llength [winNames]]} {
  464.     set win::Current ""
  465.     changeMode {}
  466.     }
  467.     requireOpenWindowsHook 2
  468. }
  469.  
  470. proc deactivateHook name {
  471.     hook::callAll deactivateHook "" $name
  472. }
  473.  
  474. proc suspendHook name {
  475.     hook::callAll suspendHook "" $name
  476.     global iconifyOnSwitch
  477.     global suspIconed
  478.     if {$iconifyOnSwitch} {
  479.         set wins [winNames -f]
  480.         set suspIconed ""
  481.         foreach win $wins {
  482.             if {![icon -f "$win" -q]} {
  483.                 lappend suspIconed $win
  484.                 icon -f "$win" -t
  485.             }
  486.         }
  487.         set suspIconed [lreverse $suspIconed]
  488.     }
  489. }
  490.  
  491. ## 
  492.  # -------------------------------------------------------------------------
  493.  # 
  494.  # "resumeHook" --
  495.  # 
  496.  #  The parameter 'name' is not used, so please ignore it.
  497.  # -------------------------------------------------------------------------
  498.  ##
  499. proc resumeHook name {
  500.     global iconifyOnSwitch resumeRevert suspIconed killCompilerErrors
  501.     
  502.     if {[info exists killCompilerErrors] && $killCompilerErrors} {
  503.     set wins [winNames -f]
  504.     if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  505.         bringToFront [lindex $wins $res]
  506.         killWindow
  507.     }
  508.     }
  509.     
  510.     if {$iconifyOnSwitch && [info exists suspIconed]} {
  511.     set wins [winNames -f]
  512.     foreach win $suspIconed {
  513.         icon -f "$win" -o
  514.     }
  515.     unset suspIconed
  516.     }
  517.     if {$resumeRevert} {
  518.     set resumeRevert 0
  519.     revert
  520.     }
  521.     # Check if the foremost window needs to be have its modified
  522.     # status adjusted
  523.     modifiedCheck [win::Current]
  524.  
  525.     hook::callAll resumeHook "" $name
  526. }
  527.  
  528. proc modifiedCheck {name} {
  529.     if {$name != ""} {
  530.     if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  531.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  532.       && (![catch {getFileInfo $nm info}]))} {
  533.         if {[catch {getWinInfo -w $name arr}]} {
  534.         set mod 0
  535.         } else {
  536.         set dirty $arr(dirty)
  537.         if {!$dirty} {
  538.             global win::Modified
  539.             set mod [expr {[set win::Modified($name)] < $info(modified)}]
  540.             if {$mod} { message "File has changed on disk since last save." }
  541.         } else {
  542.             set mod 1
  543.         }
  544.         }
  545.         enableMenuItem File save $mod
  546.         enableMenuItem File revert $mod
  547.     }
  548.     }
  549. }
  550.  
  551.  
  552. ## 
  553.  # -------------------------------------------------------------------------
  554.  # 
  555.  # "saveasHook" --
  556.  # 
  557.  #  Called when saving a window which doesn't yet exist as a file
  558.  #  (in particular 'Untitled' windows) or when the user selects
  559.  #  saveAs.
  560.  # -------------------------------------------------------------------------
  561.  ##
  562. proc saveasHook {oldName newName} {
  563.     global win::Modes win::Active win::Current win::Modified
  564.     if {$oldName == $newName} return
  565.     win::removeFromMenu $oldName
  566.     win::addToMenu $newName
  567.     win::setMode $newName
  568.     changeMode [set win::Modes($newName)]
  569.     
  570.     if {[set ind [lsearch -exact ${win::Active} $oldName]] >= 0} {
  571.     set win::Active [linsert [lreplace ${win::Active} $ind $ind] 0 $newName]
  572.     } else {
  573.     # hmmm! this is bad.  The old window has gone!
  574.     set win::Active [linsert ${win::Active} 0 $newName]
  575.     }
  576.     
  577.     set win::Current $newName
  578.     if {[info exists win::Modes($oldName)]} {
  579.     unset win::Modes($oldName)
  580.     }
  581.     if {[info exists win::Modified($oldName)]} {
  582.     unset win::Modified($oldName)
  583.     }
  584.  
  585.     hook::callAll saveasHook [set win::Modes($newName)] $oldName $newName
  586.     refresh
  587. }
  588.  
  589. ## 
  590.  # -------------------------------------------------------------------------
  591.  # 
  592.  # "saveACopyAs" --
  593.  # 
  594.  # Finally a proc to add to your collection of Alpha bugs.
  595.  # copyFile has an interesting bug. If the destination file exists it
  596.  # puts the file in [pwd] instead. This proc makes sure it is removed first.
  597.  #  
  598.  # (This proc actually has nothing to do with hooks, but seemed to fit here)
  599.  # -------------------------------------------------------------------------
  600.  ##
  601. proc saveACopyAs {} {
  602.     if {[file exists [set nm [stripNameCount [win::Current]]]]} {
  603.     set nm2 [putfile "Save a copy as:" [file tail $nm]]
  604.     if {[file exists $nm2]} {file delete $nm2}
  605.     file copy $nm $nm2
  606.     }
  607. }
  608.  
  609.  
  610. ensureset win::Active ""
  611.  
  612. proc activateHook {name} {
  613.     global win::Modes win::Active win::Current win::Modified
  614.     
  615.     if {![info exists win::Modes($name)]} {
  616.     win::setMode $name
  617.     }
  618.     if {[set ind [lsearch -exact ${win::Active} $name]] == -1} {
  619.     set win::Active [linsert ${win::Active} 0 $name]
  620.     } elseif {$ind >= 1} {
  621.     set win::Active [linsert [lreplace ${win::Active} $ind $ind] 0 $name]
  622.     }
  623.     set win::Current $name
  624.     
  625.     changeMode [set win::Modes($name)]
  626.     
  627.     hook::callAll activateHook [set win::Modes($name)] $name
  628.     
  629.     # if the file exists (this seems to be the quickest way to check)
  630.     if {[file exists $name] || \
  631.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm])} {
  632.     # this fails if the window is just opening, but then we know it's clean
  633.     if {[catch {getWinInfo -w $name arr}]} {
  634.         set dirty 0
  635.         set mod 0
  636.     } else {
  637.         set dirty $arr(dirty)
  638.         if {!$dirty} {
  639.         if {[info exists win::Modified($name)]} {
  640.             if {[info exists nm]} {
  641.             getFileInfo $nm modarr
  642.             } else {
  643.             getFileInfo $name modarr
  644.             }
  645.             set mod [expr {[set win::Modified($name)] < $modarr(modified)}]
  646.             if {$mod} { message "File has changed on disk since last save." }
  647.         } else {
  648.             # This is only reached if the window is just opening,
  649.             # and if we fix getWinInfo not to 'catch' above.
  650.             set mod 0
  651.         }
  652.         } else {
  653.         set mod 1
  654.         }
  655.     }
  656.     enableMenuItem File save $mod
  657.     enableMenuItem File saveUnmodified $dirty
  658.     enableMenuItem File revert $mod
  659.     enableMenuItem File revertToBackup 1
  660.     enableMenuItem File renameTo… 1
  661.     enableMenuItem Edit undo $dirty
  662.     } else {
  663.     enableMenuItem File save 0
  664.     enableMenuItem File saveUnmodified 0
  665.     enableMenuItem File revert 0
  666.     enableMenuItem File revertToBackup 0
  667.     enableMenuItem File renameTo… 0
  668.     enableMenuItem Edit undo 0
  669.     }
  670.     
  671. }
  672.  
  673. proc quitHook {} {
  674.     global PREFS alpha::tracingChannel
  675.     if {[file exists [file join $PREFS ftpTmp]]} {
  676.         catch {rm [file join $PREFS ftpTmp *]}
  677.     }
  678.     catch {close ${alpha::tracingChannel}}
  679.     saveModifiedVars
  680.     hook::callAll quitHook
  681. }
  682.  
  683. ## 
  684.  # -------------------------------------------------------------------------
  685.  # 
  686.  # "dirtyHook" --
  687.  # 
  688.  #  This proc currently has to keep track in the array 'win::Dirty' of
  689.  #  the dirty status of windows.  Its only use is if we close a dirty
  690.  #  window and select 'discard', we would otherwise have a faulty
  691.  #  'win::NumDirty' count.  If there's a different solution we should
  692.  #  get rid of the win::Dirty array.
  693.  #  
  694.  #  Note: closeHook is called after the window is gone, and killWindow
  695.  #  isn't called if you click in the close-box, so they don't solve
  696.  #  the problem.
  697.  # -------------------------------------------------------------------------
  698.  ##
  699. proc dirtyHook {name dirty} {
  700.     global winMenu win::NumDirty win::Dirty
  701.     markMenuItem -m $winMenu [file tail $name] $dirty "◊"
  702.     if {$dirty == "on" || $dirty == 1} {
  703.     set win::Dirty($name) 1
  704.     incr win::NumDirty 1
  705.     } else {
  706.     if {[info exists win::Dirty($name)]} {
  707.         unset win::Dirty($name)
  708.     }
  709.     incr win::NumDirty -1
  710.     }
  711.     enableMenuItem File save $dirty
  712.     enableMenuItem File saveUnmodified $dirty
  713.     enableMenuItem File revert $dirty
  714.     enableMenuItem File saveAll [expr {${win::NumDirty} ? 1 : 0}]
  715.     # we may still revertToBackup even if the file is clean.
  716.     # however we can't just revert.
  717.     enableMenuItem Edit undo $dirty
  718. }
  719.  
  720. proc openHook name {
  721.     global win::Modes autoMark mode screenHeight screenWidth \
  722.       forceMainScreen win::Modified PREFS
  723.  
  724.     changeMode [set win::Modes($name)]
  725.     win::addToMenu $name
  726.     message ""
  727.  
  728.     if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  729.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  730.       && (![catch {getFileInfo $nm info}]))} {
  731.         if {[info exists info(creator)] && ($info(creator) == {ttxt})} {
  732.             setWinInfo dirty 0
  733.         }
  734.         if {[info exists info(type)] && ($info(type) == {ttro})} {
  735.             catch {setWinInfo read-only 1}
  736.             message "Read-only!"
  737.         }
  738.     set win::Modified($name) $info(modified)
  739.     }
  740.  
  741.     global ${mode}modeVars
  742.     
  743.     if {$forceMainScreen} {
  744.         set geo [getGeometry]
  745.         set l [lindex $geo 0]; set t [lindex $geo 1]; set w [lindex $geo 2]; set h [lindex $geo 3]; 
  746.         if {($l < 0) || ($t < 35) || ([expr {$l + $w}] > $screenWidth) || ([expr {$t + $h + 18}] > $screenHeight)} {
  747.         defaultSize
  748.         }
  749.     }
  750.     getWinInfo arr
  751.     if {!$arr(read-only)} {
  752.     if {[info exists ${mode}modeVars(autoMark)] \
  753.       && [set ${mode}modeVars(autoMark)] \
  754.       && ![llength [getNamedMarks -n]]} {
  755.         markFile
  756.     }
  757.     }
  758.     
  759.     if {[regexp {\(tabsize:([0-9]+)\)} \
  760.       [getText [minPos] [nextLineStart [minPos]]] "" tabs]} {
  761.     setWinInfo tabsize $tabs
  762.     }
  763.     if {[string match "${PREFS}*defs.tcl" $name]} {setWinInfo read-only 1}
  764.     
  765.     requireOpenWindowsHook 2
  766.     
  767.     hook::callAll openHook [set win::Modes($name)] $name
  768. }
  769.  
  770. ## 
  771.  # -------------------------------------------------------------------------
  772.  # 
  773.  # "fileMovedHook" --
  774.  # 
  775.  #  Called by Alpha when a window's file has been moved behind our back.
  776.  #  (Only for Alpha using Tcl 8.0)
  777.  # -------------------------------------------------------------------------
  778.  ##
  779. proc fileMovedHook {from to} {
  780.     global win::Active winNumToName winNameToNum win::Modes win::Modified
  781.     if {[info exists winNameToNum($from)]} {
  782.     set i $winNameToNum($from)
  783.     unset winNameToNum($from)
  784.     set winNumToName($i) $to
  785.     set winNameToNum($to) $i
  786.     } else {
  787.     alertnote "Can't find old window.  Bad error."
  788.     }
  789.     set win::Modes($to) [set win::Modes($from)]
  790.     set win::Modified($to) [set win::Modified($from)]
  791.     unset win::Modes($from)
  792.     unset win::Modified($from)
  793.     set idx [lsearch -exact ${win::Active} $from]
  794.     if {$idx >= 0} {
  795.     set win::Active [lreplace ${win::Active} $idx $idx $to]
  796.     } else {
  797.     alertnote "Can't find the old window! Bad error in fileMovedHook."
  798.     }
  799.     hook::callAll fileMovedHook $from $to
  800. }
  801.  
  802. proc revertHook {name} {
  803.     global win::Modified
  804.     if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  805.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  806.       && (![catch {getFileInfo $nm info}]))} {
  807.     set win::Modified($name) $info(modified)
  808.     }
  809.     enableMenuItem File save 0
  810.     enableMenuItem File revert 0
  811. }
  812.  
  813. proc revertToBackup {} {
  814.     global backup backupExtension backupFolder win::Modes
  815.  
  816.     set fname [stripNameCount [win::Current]]
  817.     set dir $backupFolder
  818.     if {$dir == ""} {
  819.         set dir [file dirname $fname]
  820.     }
  821.     set bname [file join $dir "[file tail $fname]$backupExtension"]
  822.     if {![file exists $bname]} {
  823.         beep
  824.         message "Backup file '$bname' does not exist"
  825.         return
  826.     }
  827.  
  828.     if {[dialog::yesno "Revert to backup dated '[join [mtime [file mtime $bname]]]'?"]} {
  829.         killWindow
  830.  
  831.         edit $bname
  832.         saveAs -f $fname
  833.     }
  834. }
  835.  
  836.  
  837.  
  838.  
  839.  
  840.  
  841.  
  842.